home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
archiver
/
ldiff12s.zip
/
MYTOOL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-07-15
|
13KB
|
567 lines
(*---------------------------------------------------------------------------*)
(*mytool.pas ö─ùpè╓Éö (C) ÄOû╪ÿaòF NIFTY SDR SDI00147 1989/2/12*)
(*$B-,F-,I-,N- *)
(*---------------------------------------------------------------------------*)
UNIT MyTool;
INTERFACE
USES
Dos,
KErr,
MyType;
CONST
KanjiCharSet : CSet = [#$81..#$9F,#$E0..#$FC];
ErrStr : STRING = '';
VAR
Regs : Registers;
ERRF,OUTF,INF : Text;
SwitchChar : Char;
PathDelim : Char;
FUNCTION AscZ (VAR _h):STRING;
FUNCTION Byte16Chr (i:BYTE):CHAR;
FUNCTION Byte16Str (i:WORD):Str2;
FUNCTION Byte10Str (i:BYTE):Str2;
FUNCTION ChkDir (path:PathStr):BOOLEAN;
FUNCTION ChkWild (path:PathStr):CHAR;
FUNCTION ClrL (len:BYTE;c:CHAR):STRING;
FUNCTION CmpExt (s:STRING):BOOLEAN;
FUNCTION CmpStr (s1,s2:STRING):INTEGER;
FUNCTION CmpWithWild (s1,s2:STRING):BOOLEAN;
FUNCTION DateTimeStr (time:LONGINT):Str18;
FUNCTION DelSpace (s:STRING):STRING;
FUNCTION DosFree :LONGINT;
FUNCTION FExist (path:PathStr):WORD;
FUNCTION FileAtrStr (VAR attr:BYTE):Str6;
FUNCTION Fill (n:BYTE;c:CHAR):STRING;
PROCEDURE FSplit (path:PathStr;VAR d:DirStr;VAR n:NameStr;VAR e:ExtStr);
FUNCTION FTime (path:PathStr):LONGINT;
FUNCTION GetChar :CHAR;
FUNCTION GetDirName (VAR s:DirStr):Str13;
FUNCTION GetEnviro (s:STRING):STRING;
FUNCTION GetStr (VAR s:STRING):STRING;
FUNCTION Long16Str (n:longint):Str8;
FUNCTION Long2Char (l:LONGINT):Str4;
FUNCTION LengZ (VAR _h):WORD;
FUNCTION MaxLong (x,y:LONGINT):LONGINT;
FUNCTION MinLong (x,y:LONGINT):LONGINT;
FUNCTION NewFname (old:PathStr;ext:ExtStr;mode:CHAR):PathStr;
FUNCTION NoCheckCTRL (fh:WORD):BYTE;
FUNCTION ChangeDirName(d:DirStr):DirStr;
FUNCTION ReMove (fn:PathStr):BOOLEAN;
FUNCTION ResetFn (fn:PathStr):Str12;
FUNCTION ResetPath (path:PathStr):PathStr;
PROCEDURE SetIOCTRL (fh:WORD;code:BYTE);
FUNCTION UpCaseStr (s:STRING):STRING;
FUNCTION Word16Str (i:WORD):Str4;
IMPLEMENTATION
VAR
ExitSave : POINTER;
CONST
CHR16 : ARRAY[0..15] OF CHAR='0123456789ABCDEF';
FUNCTION MinLong(x,y:LONGINT):LONGINT;
BEGIN
IF x<y THEN MinLong:=x ELSE MinLong:=y;
END;
FUNCTION MaxLong(x,y:LONGINT):LONGINT;
BEGIN
IF x>y THEN MaxLong:=x ELSE MaxLong:=y;
END;
FUNCTION NewFname(old:PathStr;ext:ExtStr;mode:CHAR):PathStr;
VAR
d : DirStr;
n : NameStr;
e : ExtStr;
BEGIN
FSplit(old,d,n,e);
IF e='' THEN
NewFname:=old+'.'+ext
ELSE
CASE mode OF
'+' : NewFname:=old;
'-' : NewFname:=d+n+'.'+ext;
END;
END;
PROCEDURE FSplit(path:PathStr;VAR d:DirStr;VAR n:NameStr;VAR e:ExtStr);
VAR
l,p,np,ep : BYTE;
BEGIN
d:='';
n:='';
e:='';
path:=path+NUL;
l:=Length(path);
ep:=l;
np:=1;
p :=1;
WHILE path[p]<>NUL DO BEGIN
IF path[p] IN [':','\',PathDelim] THEN np:=SUCC(p);
IF path[p]='.' THEN ep:=p;
IF path[p] IN KanjiCharSet THEN Inc(p,2) ELSE Inc(p);END;
IF (Copy(path,np,l-np)='.') OR (copy(path,np,l-np)='..') THEN BEGIN
e:='';
d:=copy(path,1,PRED(np));
n:=copy(path,np,l-np);END
ELSE BEGIN
IF ep<np THEN ep:=l;
d:=copy(path, 1,PRED(np));
n:=copy(path,np,ep-np );
e:=copy(path,ep,l-ep );
END;
END;
FUNCTION DosFree:LONGINT;
VAR
env,n,m : WORD;
BEGIN
env:=Pred(MemW[PrefixSeg:$2C]);
n:=MemW[env:3];
DosFree:=LONGINT(16)*(n+MemW[Succ(env+n):3]);
END;
FUNCTION GetEnviro(s:STRING):STRING;
VAR
i,EnviroSeg : WORD;
SS : STRING;
BEGIN
EnviroSeg:=memw[PrefixSeg:$002c];
i:=0;
REPEAT
ss:=AscZ(mem[EnviroSeg:i]);
IF ss='' THEN BEGIN GetEnviro:='';Exit;END
ELSE IF Copy(ss,1,Succ(length(s)))=(s+'=') THEN BEGIN
GetEnviro:=copy(ss,length(s)+2,255);Exit;END
ELSE
Inc(i,LengZ(mem[EnviroSeg:i]));
UNTIL FALSE;
END;
FUNCTION GetStr(VAR s:STRING):STRING;
VAR
ss : STRING;
BEGIN
s:=DelSpace(s);
ss:='';
WHILE (s<>'') AND (NOT (s[1] IN [SPACE,TAB])) DO BEGIN
ss:=ss+s[1];Delete(s,1,1);END;
s:=DelSpace(s);
GetStr:=ss;
END;
FUNCTION DelSpace(s:STRING):STRING;
VAR
n : INTEGER;
_s : ARRAY[0..256] OF BYTE ABSOLUTE s;
BEGIN
n:=1;
WHILE (n<=_s[0]) and (S[n] in [SPACE,TAB]) DO INC(n);
delete(s,1,PRED(n));
n:=length(s);
WHILE (n>0) and (s[n] IN [SPACE,TAB]) DO DEC(n);
_s[0]:=n;
DelSpace:=s;
END;
PROCEDURE SetIOCTRL(fh:WORD;code:BYTE);
BEGIN
WITH Regs DO BEGIN
BX:=fh;
AX:=$4401;
DX:=code;
MsDos(Regs);
END;
END;
FUNCTION NoCheckCTRL(fh:WORD):BYTE;
BEGIN
WITH Regs DO BEGIN
AX:=$4400;
BX:=fh;
MsDos(Regs);
NoCheckCTRL:=DL;
AX:=$4401;
DX:=(DL OR $20);
MsDos(Regs);
END;
END;
FUNCTION GetChar:CHAR;
VAR
IOflg : BYTE;
c : CHAR;
fh1 : WORD;
BEGIN
WITH Regs DO BEGIN
IOflg:=NoCheckCTRL(2);
AH:=$45; BX:=1; MsDos(Regs); FH1:=AX;
AH:=$46; BX:=2; CX:=1; MsDos(Regs);
AH:=$3F; BX:=2; CX:=1; DS:=Seg(c); DX:=Ofs(c); MsDos(Regs);
AH:=$46; BX:=FH1; CX:=1; MsDos(Regs);
AH:=$3E; BX:=FH1; MsDos(Regs);
SetIOCTRL(2,IOflg);END;
GetChar:=c;
END;
FUNCTION ClrL(len:BYTE;c:CHAR):STRING;
BEGIN
ClrL:=Fill(len,c)+Fill(len,BS);
END;
FUNCTION ChkDir(path:PathStr):BOOLEAN;
VAR
d : DirStr;
n : NameStr;
e : ExtStr;
dta : SearchRec;
BEGIN
IF ChkWild(path)=NUL THEN
IF ((Length(path)=2) AND (path[2]=':')) OR
((Length(path)<>0) AND (path[Length(path)] IN [PathDelim,'\']))
THEN ChkDir:=TRUE
ELSE BEGIN
path:=UpCaseStr(path);
FSplit(path,d,n,e);
FindFirst(d+'*.*',AnyFile,dta);
WHILE DosError=0 DO WITH dta DO BEGIN
IF (n+e=name) AND ((attr AND Directory)<>0) THEN BEGIN
ChkDir:=TRUE;Exit;END;
FindNext(dta);END;
ChkDir:=FALSE;END
ELSE
ChkDir:=FALSE;
END;
FUNCTION FileAtrStr(VAR attr:BYTE):Str6;
BEGIN
FileAtrStr:=copy('-w',succ(Attr AND readonly),1)+
copy('-h',succ(ord((Attr AND hidden )= 2)),1)+
copy('-s',succ(ord((Attr AND sysfile )= 4)),1)+
copy('-v',succ(ord((Attr AND volumeid )= 8)),1)+
copy('-d',succ(ord((Attr AND directory)=16)),1)+
copy('-a',succ(ord((Attr AND archive )=32)),1);
END;
FUNCTION DateTimeStr(time:LONGINT):Str18;
VAR
years,hours : Str4;
months,days,mins,secs : Str2;
dt : datetime;
BEGIN
WITH dt DO BEGIN
unpacktime (time,dt);
Str(year ,years );
Str(month:2 ,months);
Str(day:2 ,days );
Str(hour:4 ,hours );
Str(min:2 ,mins );
Str(sec:2 ,secs );
IF months[1]=' ' THEN months[1]:='0';
IF days [1]=' ' THEN days [1]:='0';
IF mins [1]=' ' THEN mins [1]:='0';
IF secs [1]=' ' THEN secs [1]:='0';
DateTimeStr:=copy(years,3,2)+'/'+months+'/'+days+
hours +':'+mins +':'+secs;
END;
END;
FUNCTION CmpWithWild(s1,s2:STRING):BOOLEAN;
VAR
i : BYTE;
s : STRING;
BEGIN
CmpWithWild:=FALSE;
CASE ChkWild(s1) OF
NUL : BEGIN CmpWithWild:=(s1=s2);Exit;END;
'?' : IF length(s1)<>length(s2) THEN Exit ELSE s:=s1;
ELSE
IF Pred(Length(s1))>Length(s2) THEN Exit;
s:=Fill(Length(s2),'?');
IF s1[Length(s1)]='*' THEN
FOR i:=1 TO Pred(Length(s1)) DO s[i]:=s1[i]
ELSE
FOR i:=Length(s1) DOWNTO 2 DO s[Length(s)-Length(s1)+i]:=s1[i];END;
FOR i:=1 to Length(s) DO IF (